home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-modul.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-02-18  |  12.5 KB  |  513 lines
  1. /*  $Id: pl-modul.c,v 1.19 1998/02/18 13:57:05 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: module management
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  13. Definition of modules.  A module consists of a  set  of  predicates.   A
  14. predicate  can be private or public.  By default predicates are private.
  15. A module contains two hash tables.  One that holds  all  predicates  and
  16. one that holds the public predicates of the module.
  17.  
  18. On trapping undefined  predicates  SWI-Prolog  attempts  to  import  the
  19. predicate  from  the  super  module  of the module.  The module `system'
  20. holds all system predicates and has no super module.  Module  `user'  is
  21. the  global  module  for  the  user  and imports from `system' all other
  22. modules import from `user' (and indirect from `system').
  23. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  24.  
  25. Module
  26. lookupModule(atom_t name)
  27. { Symbol s;
  28.   Module m;
  29.  
  30.   if ((s = lookupHTable(GD->tables.modules, (void*)name)) != (Symbol) NULL)
  31.     return (Module) s->value;
  32.  
  33.   m = allocHeap(sizeof(struct module));
  34.   m->name = name;
  35.   m->file = (SourceFile) NULL;
  36.   clearFlags(m);
  37.   set(m, UNKNOWN);
  38.  
  39.   if ( name == ATOM_user || name == ATOM_system )
  40.     m->procedures = newHTable(PROCEDUREHASHSIZE);
  41.   else
  42.     m->procedures = newHTable(MODULEPROCEDUREHASHSIZE);
  43.  
  44.   m->public = newHTable(PUBLICHASHSIZE);
  45.  
  46.   if ( name == ATOM_user || stringAtom(name)[0] == '$' )
  47.     m->super = MODULE_system;
  48.   else if ( name == ATOM_system )
  49.     m->super = NULL;
  50.   else
  51.     m->super = MODULE_user;
  52.  
  53.   if ( name == ATOM_system || stringAtom(name)[0] == '$' )
  54.     set(m, SYSTEM);
  55.  
  56.   addHTable(GD->tables.modules, (void *)name, m);
  57.   GD->statistics.modules++;
  58.   
  59.   return m;
  60. }
  61.  
  62.  
  63. static Module
  64. isCurrentModule(atom_t name)
  65. { Symbol s;
  66.   
  67.   if ( (s = lookupHTable(GD->tables.modules, (void*)name)) )
  68.     return (Module) s->value;
  69.  
  70.   return NULL;
  71. }
  72.  
  73.  
  74. void
  75. initModules(void)
  76. { GD->tables.modules = newHTable(MODULEHASHSIZE);
  77.   GD->modules.system = lookupModule(ATOM_system);
  78.   GD->modules.user   = lookupModule(ATOM_user);
  79.   LD->modules.typein = MODULE_user;
  80.   LD->modules.source = MODULE_user;
  81. }
  82.  
  83. int
  84. isSuperModule(Module s, Module m)
  85. { while(m)
  86.   { if ( m == s )
  87.       succeed;
  88.     m = m->super;
  89.   }
  90.  
  91.   fail;
  92. }
  93.  
  94. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  95. stripModule() takes an atom or term, possible embedded in the :/2 module
  96. term.  It will assing *module with the associated module and return  the
  97. remaining term.
  98. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  99.  
  100. Word
  101. stripModule(Word term, Module *module)
  102. { deRef(term);
  103.  
  104.   while( hasFunctor(*term, FUNCTOR_module2) )
  105.   { Word mp;
  106.     mp = argTermP(*term, 0);
  107.     deRef(mp);
  108.     if ( !isAtom(*mp) )
  109.       break;
  110.     *module = lookupModule(*mp);
  111.     term = argTermP(*term, 1);
  112.     deRef(term);
  113.   }
  114.  
  115.   if ( ! *module )
  116.     *module = (environment_frame ? contextModule(environment_frame)
  117.                         : MODULE_user);
  118.  
  119.   return term;
  120. }
  121.  
  122. bool
  123. isPublicModule(Module module, Procedure proc)
  124. { if ( lookupHTable(module->public,
  125.             (void *)proc->definition->functor->functor) )
  126.     succeed;
  127.  
  128.   fail;
  129. }
  130.  
  131.  
  132.         /********************************
  133.         *       PROLOG CONNECTION       *
  134.         *********************************/
  135.  
  136. word
  137. pl_default_module(term_t me, term_t old, term_t new)
  138. { Module m, s;
  139.   atom_t a;
  140.  
  141.   if ( PL_is_variable(me) )
  142.   { m = contextModule(environment_frame);
  143.     TRY(PL_unify_atom(me, m->name));
  144.   } else if ( PL_get_atom(me, &a) )
  145.   { m = lookupModule(a);
  146.   } else
  147.     return warning("super_module/2: instantiation fault");
  148.  
  149.   TRY(PL_unify_atom(old, m->super ? m->super->name : ATOM_nil));
  150.  
  151.   if ( !PL_get_atom(new, &a) )
  152.     return warning("super_module/2: instantiation fault");
  153.  
  154.   s = (a == ATOM_nil ? NULL : lookupModule(a));
  155.   m->super = s;
  156.  
  157.   succeed;
  158. }
  159.  
  160.  
  161. word
  162. pl_current_module(term_t module, term_t file, word h)
  163. { Symbol symb = firstHTable(GD->tables.modules);
  164.   atom_t name;
  165.  
  166.   if ( ForeignControl(h) == FRG_CUTTED )
  167.     succeed;
  168.  
  169.                     /* deterministic cases */
  170.   if ( PL_get_atom(module, &name) )
  171.   { for(; symb; symb = nextHTable(GD->tables.modules, symb) )
  172.     { Module m = (Module) symb->value;
  173.  
  174.       if ( name == m->name )
  175.       { atom_t f = (!m->file ? ATOM_nil : m->file->name);
  176.     return PL_unify_atom(file, f);
  177.       }
  178.     }
  179.  
  180.     fail;
  181.   } else if ( PL_get_atom(file, &name) )
  182.   { for( ; symb; symb = nextHTable(GD->tables.modules, symb) )
  183.     { Module m = (Module) symb->value;
  184.  
  185.       if ( m->file && m->file->name == name )
  186.     return PL_unify_atom(module, m->name);
  187.     }
  188.  
  189.     fail;
  190.   }
  191.  
  192.   switch( ForeignControl(h) )
  193.   { case FRG_FIRST_CALL:
  194.       break;
  195.     case FRG_REDO:
  196.       symb = ForeignContextPtr(h);
  197.       break;
  198.     default:
  199.       assert(0);
  200.   }
  201.  
  202.   for( ; symb; symb = nextHTable(GD->tables.modules, symb) )
  203.   { Module m = (Module) symb->value;
  204.  
  205.     if ( stringAtom(m->name)[0] == '$' &&
  206.      !SYSTEM_MODE && PL_is_variable(module) )
  207.       continue;
  208.  
  209.     { fid_t cid = PL_open_foreign_frame();
  210.       atom_t f = ( !m->file ? ATOM_nil : m->file->name);
  211.  
  212.       if ( PL_unify_atom(module, m->name) &&
  213.        PL_unify_atom(file, f) )
  214.       { if ( !(symb = nextHTable(GD->tables.modules, symb)) )
  215.       succeed;
  216.  
  217.     ForeignRedoPtr(symb);
  218.       }
  219.  
  220.       PL_discard_foreign_frame(cid);
  221.     }
  222.   }
  223.  
  224.   fail;
  225. }
  226.  
  227.  
  228. word
  229. pl_strip_module(term_t spec, term_t module, term_t term)
  230. { Module m = (Module) NULL;
  231.   term_t plain = PL_new_term_ref();
  232.  
  233.   PL_strip_module(spec, &m, plain);
  234.   if ( PL_unify_atom(module, m->name) &&
  235.        PL_unify(term, plain) )
  236.     succeed;
  237.  
  238.   fail;
  239. }  
  240.  
  241.  
  242. word
  243. pl_module(term_t old, term_t new)
  244. { if ( PL_unify_atom(old, LD->modules.typein->name) )
  245.   { atom_t name;
  246.  
  247.     if ( !PL_get_atom(new, &name) )
  248.       return warning("module/2: argument should be an atom");
  249.  
  250.     LD->modules.typein = lookupModule(name);
  251.     succeed;
  252.   }
  253.  
  254.   fail;
  255. }
  256.  
  257.  
  258. word
  259. pl_set_source_module(term_t old, term_t new)
  260. { if ( PL_unify_atom(old, LD->modules.source->name) )
  261.   { atom_t name;
  262.  
  263.     if ( !PL_get_atom(new, &name) )
  264.       return warning("$source_module/2: argument should be an atom");
  265.  
  266.     LD->modules.source = lookupModule(name);
  267.     succeed;
  268.   }
  269.  
  270.   fail;
  271. }
  272.  
  273.  
  274. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  275. Find the module in which to call   term_expansion/2. This is the current
  276. source-module and module user, provide term_expansion/2 is defined. Note
  277. this predicate does not generate modules for which there is a definition
  278. that has no clauses. The predicate would fail anyhow.
  279. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  280.  
  281. word
  282. pl_term_expansion_module(term_t name, word h)
  283. { Module m = LD->modules.source;
  284.   Procedure proc;
  285.  
  286.   switch(ForeignControl(h))
  287.   { case FRG_FIRST_CALL:
  288.       m = LD->modules.source;
  289.       break;
  290.     case FRG_REDO:
  291.       m = MODULE_user;
  292.       break;
  293.     default:
  294.       succeed;
  295.   }
  296.  
  297.   while(1)
  298.   { if ( (proc = isCurrentProcedure(FUNCTOR_term_expansion2, m)) &&
  299.      proc->definition->definition.clauses &&
  300.      PL_unify_atom(name, LD->modules.source->name) )
  301.     { if ( m == MODULE_user )
  302.     PL_succeed;
  303.       else
  304.     ForeignRedoInt(1);
  305.     } else
  306.     { if ( m == MODULE_user )
  307.     PL_fail;
  308.       m = MODULE_user;
  309.     }
  310.   }
  311.  
  312.   PL_fail;                /* should not get here */
  313. }
  314.  
  315.  
  316. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  317. Declare `name' to be a module with `file' as its source  file.   If  the
  318. module was already loaded its public table is cleared and all procedures
  319. in it are abolished.
  320. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  321.  
  322. int
  323. declareModule(atom_t name, SourceFile sf)
  324. { Module module = lookupModule(name);
  325.   Symbol s;
  326.  
  327.   if ( module->file && module->file != sf)
  328.   { warning("module/2: module %s already loaded from file %s (abandoned)", 
  329.         stringAtom(module->name), 
  330.         stringAtom(module->file->name));
  331.     fail;
  332.   }
  333.         
  334.   module->file = sf;
  335.   LD->modules.source = module;
  336.  
  337.   for_table(s, module->procedures)
  338.   { Procedure proc = (Procedure) s->value;
  339.     Definition def = proc->definition;
  340.     if ( def->module == module &&
  341.      !true(def, DYNAMIC|MULTIFILE|FOREIGN) )
  342.       abolishProcedure(proc, module);
  343.   }
  344.   clearHTable(module->public);
  345.   
  346.   succeed;
  347. }
  348.  
  349.  
  350. word
  351. pl_declare_module(term_t name, term_t file)
  352. { SourceFile sf;
  353.   atom_t mname, fname;
  354.  
  355.   if ( !PL_get_atom(name, &mname) ||
  356.        !PL_get_atom(file, &fname) )
  357.     return warning("$declare_module/2: instantiation fault");
  358.  
  359.   sf = lookupSourceFile(fname);
  360.   return declareModule(mname, sf);
  361. }
  362.  
  363. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  364. export_list(+Module, -PublicPreds)
  365. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  366.  
  367. word
  368. pl_export_list(term_t modulename, term_t public)
  369. { Module module;
  370.   atom_t mname;
  371.   Symbol s;
  372.  
  373.   if ( !PL_get_atom(modulename, &mname) )
  374.     return warning("export_list/2: instantiation fault");
  375.   
  376.   if ( !(module = isCurrentModule(mname)) )
  377.     fail;
  378.   
  379.   { term_t head = PL_new_term_ref();
  380.     term_t list = PL_copy_term_ref(public);
  381.  
  382.     for_table(s, module->public)
  383.     { if ( !PL_unify_list(list, head, list) ||
  384.        !PL_unify_functor(head, (functor_t)s->name) )
  385.     fail;
  386.     }
  387.  
  388.     return PL_unify_nil(list);
  389.   }
  390.   
  391. }
  392.  
  393.  
  394. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  395. pl_export() exports a procedure specified by its name and arity from the
  396. context module.
  397. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  398.  
  399. word
  400. pl_export(term_t pred)
  401. { Module module = NULL;
  402.   term_t head = PL_new_term_ref();
  403.   functor_t fd;
  404.  
  405.   PL_strip_module(pred, &module, head);
  406.   if ( PL_get_functor(head, &fd) )
  407.   { Procedure proc = lookupProcedure(fd, module);
  408.  
  409.     addHTable(module->public,
  410.           (void *)proc->definition->functor->functor,
  411.           proc);
  412.     succeed;
  413.   }
  414.  
  415.   return warning("export/1: illegal predicate specification");
  416. }
  417.  
  418. word
  419. pl_check_export()
  420. { Module module = contextModule(environment_frame);
  421.   Symbol s;
  422.  
  423.   for_table(s, module->public)
  424.   { Procedure proc = (Procedure) s->value;
  425.     Definition def = proc->definition;
  426.  
  427.     if ( !isDefinedProcedure(proc) )
  428.     { warning("Exported procedure %s:%s/%d is not defined", 
  429.                   stringAtom(module->name), 
  430.                   stringAtom(def->functor->name), 
  431.                   def->functor->arity);
  432.     }
  433.   }
  434.  
  435.   succeed;
  436. }
  437.  
  438. word
  439. pl_context_module(term_t module)
  440. { return PL_unify_atom(module, contextModule(environment_frame)->name);
  441. }
  442.  
  443. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  444. pl_import() imports the predicate specified with its argument  into  the
  445. current  context  module.   If  the  predicate is already defined in the
  446. context a warning is displayed and the predicate is  NOT  imported.   If
  447. the  predicate  is  not  on  the  public  list of the exporting module a
  448. warning is displayed, but the predicate is imported nevertheless.
  449. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  450.  
  451. word
  452. pl_import(term_t pred)
  453. { Module source = NULL;
  454.   Module destination = contextModule(environment_frame);
  455.   term_t head = PL_new_term_ref();
  456.   functor_t fd;
  457.   Procedure proc, old;
  458.  
  459.   PL_strip_module(pred, &source, head);
  460.   if ( !PL_get_functor(head, &fd) )
  461.     return warning("import/1: instantiation fault");
  462.   proc = lookupProcedure(fd, source);
  463.  
  464.   if ( !isDefinedProcedure(proc) )
  465.     autoImport(proc->definition->functor->functor, proc->definition->module);
  466.  
  467.   if ( (old = isCurrentProcedure(proc->definition->functor->functor,
  468.                  destination)) )
  469.   { if ( old->definition == proc->definition )
  470.       succeed;            /* already done this! */
  471.  
  472.     if ( !isDefinedProcedure(old) )
  473.     { old->definition = proc->definition;
  474.  
  475.       succeed;
  476.     }
  477.  
  478.     if ( old->definition->module == destination )
  479.       return warning("Cannot import %s into module %s: name clash", 
  480.              procedureName(proc), 
  481.              stringAtom(destination->name) );
  482.  
  483.     if ( old->definition->module != source )
  484.     { warning("Cannot import %s into module %s: already imported from %s", 
  485.           procedureName(proc), 
  486.           stringAtom(destination->name), 
  487.           stringAtom(old->definition->module->name) );
  488.       fail;
  489.     }
  490.  
  491.     sysError("Unknown problem importing %s into module %s",
  492.          procedureName(proc),
  493.          stringAtom(destination->name));
  494.     fail;
  495.   }
  496.  
  497.   if ( !isPublicModule(source, proc) )
  498.   { warning("import/1: %s is not declared public (still imported)", 
  499.         procedureName(proc));
  500.   }
  501.   
  502.   { Procedure nproc = (Procedure)  allocHeap(sizeof(struct procedure));
  503.   
  504.     nproc->type = PROCEDURE_TYPE;
  505.     nproc->definition = proc->definition;
  506.   
  507.     addHTable(destination->procedures,
  508.           (void *)proc->definition->functor->functor, nproc);
  509.   }
  510.  
  511.   succeed;
  512. }
  513.